#!/usr/bin/perl
#
# A run-once script: Email all frozen people who haven't gotten an
# email in 6 months.
#
# NOTE: there is a "sleep" in there.
# The counter currently hurts when it gets more than 3000 updates/day.
# So we don't send out more than 1 mail per 30 seconds, which gives
# 2880 emails per day.
# This is not discounted for return rate; normal reminder emails seem
# to bring in less than half the users reminded (500 logins
# per day for 2000 reminders). But we need some room for normal use too.
#
# Update HTA 2005: Lowering delay to 5 secs. Machine is faster now.
#
use Counter;
use Getopt::Long;
use NoteHandler;

$users = Counter::open();
$n = new NoteHandler;

$limit = "100000";
$DEBUG = 0;
$usertoget = 0;
$agecheck = 0;
$orderby = "f_mtime";
$interval = 5;

GetOptions("limit=s" => \$limit,
	   "debug" => \$DEBUG,
	   "user=i" => \$usertoget,
	   "test" => \$test,
	   "agecheck" => \$agecheck,
	   "orderby=s" => \$orderby,
	   );
         

warn "Limit is $limit\n";
if ($usertoget) {
    $userelm = "and f_key = '$usertoget'";
} elsif ($agecheck) {
    $userelm = "and f_mtime > emailtime";
}
$start = time();
@users = $users->select("state = 'frozen' $userelm order by $orderby desc limit $limit"); 
warn "Found ", @users + 0, " users\n";
warn "Query took ", time() - $start, " seconds\n";
$done = 0;
$bombs = 0;
for $user (@users) {
    ++ $done;
    print STDERR "$done\r" if -t STDERR;
    $n->start($user->key());
    eval { process($user);};
    if ($@) {
	$n->note("Processing bombed: $@");
	$n->done("Processing bombed");
	++ $bombs;
	last if $bombs > 10; # stop if things have gone totally haywire
    }
}

$n->report();
for $k (keys(%counts)) {
    print "$counts{$k} $k\n";
}

sub process {

    my $user = shift;

    if (!$user->hasfrozen()) {
	$DEBUG && $n->note("No frozen records");
	$n->done("no frozen records");
	return;
    }
    my @emails = $user->emails('main');
    my $email = $emails[0];
    my $emailstring;

    if ($email) {
	$emailstring = $email->key();
    }
    # There are some records with trailing spaces in the userrec...
    if ($$user{email} =~ /\s$/) {
	$n->note("Repairing trailing space in <$$user{email}>");
	$$user{email} =~ s/\s+$//;
	$user->store() if !$test;
    }
    if (!$email) {
	$DEBUG && $n->note("No main email (userrec: $$user{email})");
	$n->done("No main email");
	return;
    } elsif ($emails[1]) {
	$n->note("Multiple main email");
	$n->done("multiple main");
	return;
    } elsif ("\L$emailstring" ne "\L$$user{email}") {
	$n->note("<$emailstring> not equal to <$$user{email}>");
	$n->done("mismatch main");
	return;
    }
    if ($email->{state} eq "bad" && $email->{level} ne "MAIL") {
#    if ($email->{state} eq "bad") {
# Note - tried sending mail to all bad/bounce below 3000.
# Very many bounces returned. 572 currently left there (2001-12-01).
# Let us see if any return. Until then...
# 2001-12-04: So far, 5 returned. 1% - not bad. restore.
#
	$DEBUG && warn $user->key, ": Email is bad - $$email{state} $$email{level} $$email{error}\n";
	$n->done("bad email level $$email{level}");
	return;
    }
    if ($user->{emailtime} ge $user->freezetime()) {
	$DEBUG && $n->note("emailtime $$user{emailtime}, freezetime " . $user->freezetime());
	$n->done("sent email after being frozen");
	return;
    }
    if (!$test) {
	system("sendemail", $user->key());
	print "Sent email to ", $user->key(), " as ", $user->{email}, "\n";
	sleep $interval; # don't overload
    } else {
	print "Sent (NOT) email to ", $user->key(), " as ", $user->{email}, "\n";
    }
    $n->done(sent);
}

